home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk68 / c2mod / files.mod < prev   
Encoding:
Modula Implementation  |  1995-03-19  |  7.3 KB  |  228 lines
  1. IMPLEMENTATION MODULE Files;
  2.  
  3. (*
  4.    Routines for finding information about files.
  5.  
  6.    Revision history:
  7.      0.00
  8.  
  9.  
  10.    Copyright 1987 by:
  11.      Dale W. Thompson, 14500 Dallas Pkwy. #2091, Dallas, TX 75240
  12.  
  13.      This module and/or its procedures may be freely used by anyone,
  14.      but please acknowledge its use in any copyright notice of a
  15.      publicly distributed program.  Thank you.
  16.  
  17.      Please forward any comments, problems, or suggestions to me
  18.      at the address given, or to my CompuServe ID 75115,734.
  19. *)
  20.  
  21. FROM Dates IMPORT ParseDate;
  22. FROM DOSFiles IMPORT Open, Close, ModeOldFile, ModeNewFile, Read, Write,
  23.                      FileHandle, FileLock, Unlock, Lock,
  24.                      Examine, ExNext, AccessRead, FileInfoBlock,
  25.                      FileInfoBlockPtr, ParentDir;
  26. FROM Memory IMPORT AllocMem, FreeMem, MemClear, MemPublic, MemReqSet;
  27. FROM Strings IMPORT Length, Concat, Assign, Pos;
  28. FROM Strings2 IMPORT Equal;
  29. FROM SYSTEM IMPORT ADR, TSIZE, NULL;
  30.  
  31. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  32. PROCEDURE FileExists( VAR name: ARRAY OF CHAR ): BOOLEAN;
  33.  
  34.     VAR fl : FileLock;
  35.  
  36.     BEGIN
  37.       fl := Lock( name, AccessRead );
  38.       IF fl <> 0 THEN Unlock( fl ) END;
  39.       RETURN fl <> 0;
  40.     END (* PROCEDURE *) FileExists;
  41.  
  42. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  43. PROCEDURE CopyFile( VAR fileIn, fileOut : ARRAY OF CHAR ): BOOLEAN;
  44.  
  45.     CONST bufsize = 512;
  46.  
  47.     VAR
  48.       hI, hO : FileHandle;
  49.       readbytes, writbytes : LONGINT;
  50.       copybuf : ARRAY [0..bufsize-1] OF CHAR;
  51.       filecopied : BOOLEAN;
  52.  
  53.     BEGIN
  54.       filecopied := FALSE;
  55.       hI := Open( fileIn,  ModeOldFile );
  56.       IF hI # 0 THEN
  57.          hO := Open( fileOut, ModeNewFile );
  58.          IF hO # 0 THEN
  59.             REPEAT
  60.               readbytes := Read ( hI, ADR(copybuf), bufsize);
  61.               writbytes := Write( hO, ADR(copybuf), LONGCARD(readbytes) );
  62.             UNTIL readbytes < bufsize;
  63.             Close(hO);
  64.             filecopied := TRUE;
  65.          END;
  66.          Close(hI);
  67.       END;
  68.       RETURN filecopied;
  69.     END (* PROCEDURE *) CopyFile;
  70.  
  71. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  72. PROCEDURE ReadDir( VAR Dir : ARRAY OF CHAR;
  73.                    VAR fia : ARRAY OF FileInfo ) : CARDINAL;
  74. (* returns number of files in directory *)
  75.    VAR
  76.       DirLock : FileLock;
  77.       fibptr  : FileInfoBlockPtr;
  78.       i       : CARDINAL;
  79.  
  80.    BEGIN
  81.       i := 0;
  82.       fibptr := AllocMem( LONGCARD(TSIZE(FileInfoBlock)),
  83.                           MemReqSet{MemPublic,MemClear} );
  84.       IF fibptr # NULL THEN          (* check for valid pointer   *)
  85.          DirLock := Lock( Dir, AccessRead );
  86.          IF DirLock > 0 THEN         (* check for successful lock *)
  87.             IF Examine( DirLock, fibptr^ ) THEN
  88.               Fillfi( fia[0], fibptr );
  89.                WHILE ExNext( DirLock, fibptr^ ) & (i <= CARDINAL(HIGH(fia))) DO
  90.                   INC(i);
  91.                  Fillfi( fia[i], fibptr );
  92.                END; (* WHILE *)
  93.             END; (* IF Examine() *)
  94.             Unlock( DirLock );
  95.          END; (* IF DirLock > 0 *)
  96.          FreeMem( fibptr, LONGCARD(TSIZE(FileInfoBlock)) );
  97.       END; (* IF fibptr # NULL *)
  98.       RETURN i;      (* number of files in dir *)
  99.    END (* PROCEDURE *) ReadDir;
  100.  
  101.  
  102. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  103. PROCEDURE IsDirectory( VAR file : ARRAY OF CHAR ) : BOOLEAN;
  104.  
  105.    VAR fia : FileInfo;
  106.  
  107.    BEGIN
  108.      IF GetFileInfo ( file, fia) THEN
  109.        IF (fia.Type = Directory) THEN RETURN TRUE END;
  110.      END;
  111.      RETURN FALSE;
  112.    END (* PROCEDURE *) IsDirectory;
  113.  
  114.  
  115. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  116. PROCEDURE GetFileInfo( VAR file : ARRAY OF CHAR;
  117.                        VAR fia  : FileInfo ) : BOOLEAN;
  118.  
  119.    VAR
  120.       fl      : FileLock;
  121.       DirLock : FileLock;
  122.       fibptr  : FileInfoBlockPtr;
  123.       i       : BOOLEAN;
  124.  
  125.    BEGIN
  126.       i := FALSE;
  127.       fibptr := AllocMem( LONGCARD(TSIZE(FileInfoBlock)),
  128.                           MemReqSet{MemPublic,MemClear} );
  129.       IF fibptr # NULL THEN          (* check for valid pointer   *)
  130.          fl := Lock( file, AccessRead );
  131.          IF fl > 0 THEN         (* check for successful lock *)
  132.             DirLock := ParentDir( fl );
  133.             IF DirLock > 0 THEN         (* check for successful lock *)
  134.                IF Examine( DirLock, fibptr^ ) THEN
  135.                  LOOP
  136.                     IF NOT ExNext( DirLock, fibptr^ ) THEN EXIT END;
  137.                     Fillfi( fia, fibptr );
  138.                     IF Equal( file, fia.Name ) THEN i := TRUE; EXIT; END;
  139.                  END;
  140.                END; (* IF Examine() *)
  141.                Unlock( DirLock );
  142.             END; (* IF DirLock > 0 *)
  143.             Unlock( fl );
  144.          END; (* IF fl > 0 *)
  145.       END; (* IF fibptr # NULL *)
  146.       FreeMem( fibptr, LONGCARD(TSIZE(FileInfoBlock)) );
  147.       RETURN i;      (* TRUE if FileInfo filled in *)
  148.    END (* PROCEDURE *) GetFileInfo;
  149.  
  150.  
  151. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  152. PROCEDURE Fillfi( VAR fia     : FileInfo;
  153.                       fibptr  : FileInfoBlockPtr );
  154.  
  155.   BEGIN
  156.       Assign( fia.Name, fibptr^.fibFileName );
  157.       ParseDate( fibptr^.fibDate, fia.Date );
  158.       Assign( fia.Comment, fibptr^.fibComment );
  159.       IF fibptr^.fibDirEntryType > 0 THEN
  160.         fia.Type := Directory;
  161.       ELSE
  162.         fia.Type := File;
  163.       END;
  164.       fia.Size   := fibptr^.fibSize;
  165.   END (* PROCEDURE *) Fillfi;
  166.  
  167. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  168. PROCEDURE GetCurrentDir( VAR Path : ARRAY OF CHAR ): BOOLEAN;
  169.  
  170.    BEGIN
  171.       RETURN GetSpec( CurrentDirLock(), Path )
  172.    END (* PROCEDURE *) GetCurrentDir;
  173.  
  174.  
  175. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  176. PROCEDURE GetSpec(     lock : FileLock;
  177.                    VAR Path : ARRAY OF CHAR ): BOOLEAN;
  178.  
  179.    VAR
  180.       i       : CARDINAL;
  181.       OldLock : FileLock;
  182.       fibptr  : FileInfoBlockPtr;
  183.       temp    : ARRAY [0..256] OF CHAR;
  184.       status  : BOOLEAN;
  185.  
  186.    BEGIN
  187.       status := FALSE;
  188.       Assign( temp, "" ); Assign( Path, "" );
  189.       fibptr := AllocMem( LONGCARD(TSIZE(FileInfoBlock)),
  190.                           MemReqSet{MemPublic,MemClear} );
  191.       IF fibptr # NULL THEN          (* check for valid pointer   *)
  192.          LOOP
  193.             IF lock > 0 THEN         (* check for successful lock *)
  194.                IF Examine( lock, fibptr^ ) THEN
  195.                   Concat( fibptr^.fibFileName, temp, Path );
  196.                   Concat( "/", Path, temp );
  197.                   OldLock := lock;
  198.                ELSE
  199.                   EXIT;
  200.                END; (* IF *)
  201.             ELSE
  202.                IF Pos( Path, "/", 0, i) THEN
  203.                   Path[i] := ":";
  204.                ELSE
  205.                   Concat( Path, ":", Path );
  206.                END; (* IF *)
  207.                status := TRUE;
  208.                EXIT;
  209.             END; (* IF *)
  210.             lock := ParentDir( OldLock );
  211.             Unlock( OldLock );
  212.          END; (* LOOP *)
  213.          FreeMem( fibptr, LONGCARD(TSIZE(FileInfoBlock)) );
  214.       END; (* if fibptr # NULL *)
  215.       RETURN status;
  216.    END (* PROCEDURE *) GetSpec;
  217.  
  218.  
  219. (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  220. PROCEDURE CurrentDirLock(): FileLock;
  221.  
  222.    BEGIN
  223.       RETURN Lock("", AccessRead )
  224.    END (* PROCEDURE *) CurrentDirLock;
  225.  
  226.  
  227. END (* IMPLEMENTATION MODULE *) Files.
  228.